home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #14 / Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO / prog_d / isamexpt.zip / DBF2ISAM.PAS < prev    next >
Pascal/Delphi Source File  |  1996-01-13  |  4KB  |  149 lines
  1. unit Dbf2isam;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  6.   StdCtrls, Isamtabl, Gauges, DB, DBTables, ExtCtrls,
  7.   U_DbTool, Grids, DBGrids;
  8.  
  9. type
  10.   DBASEImportProc = Procedure(var DATA; DBTable: TTable; ISTable: TIsamTable);
  11.  
  12.   TImportDlg = class(TForm)
  13.     CancelBtn: TBitBtn;
  14.     Bevel1: TBevel;
  15.     Table1: TTable;
  16.     Gauge1: TGauge;
  17.     IsamTable1: TIsamTable;
  18.     StartBttn: TBitBtn;
  19.     DataSource1: TDataSource;
  20.     DBGrid1: TDBGrid;
  21.     GroupBox1: TGroupBox;
  22.     aktualRadio: TRadioButton;
  23.     appendradio: TRadioButton;
  24.     appendandupdateradio: TRadioButton;
  25.     procedure CancelBtnClick(Sender: TObject);
  26.     procedure FormDestroy(Sender: TObject);
  27.     procedure FormCreate(Sender: TObject);
  28.     procedure FormShow(Sender: TObject);
  29.     procedure StartBttnClick(Sender: TObject);
  30.   private
  31.     { Private declarations }
  32.   public
  33.     FieldGetProc: DBASEImportProc;
  34.     Data,Dup    : Pointer;
  35.   end;
  36.  
  37. var
  38.   ImportDlg: TImportDlg;
  39.  
  40. Procedure DBase2Isam(aParent: TForm;
  41.                      IsamTable: TIsamTable;
  42.                      DBASETableName: String;
  43.                      FieldGet: DBASEImportProc);
  44.  
  45. implementation
  46.  
  47. Uses SysUtils, UToolDll, Filer;
  48.  
  49. {$R *.DFM}
  50.  
  51. procedure TImportDlg.CancelBtnClick(Sender: TObject);
  52. begin
  53.   Close;
  54. end;
  55.  
  56. Procedure DBase2Isam(aParent: TForm;
  57.                      IsamTable: TIsamTable;
  58.                      DBASETableName: String;
  59.                      FieldGet: DBASEImportProc);
  60. var AktDir: String;
  61. begin
  62.   if Pos('.',DBaseTableName) > 0 then DBaseTableName:= Copy(DBaseTableName,1,Pos('.',DBaseTableName)-1);
  63.   DBaseTableName:= DBaseTableName + '.DBF';
  64.   AktDir:= ExtractFilePath(Application.ExeName);
  65.   Check_Alias('TEST2',AktDir);
  66.   ImportDlg:= TImportDlg.Create(aParent);
  67.   Try
  68.     ImportDlg.IsamTable1:= IsamTable;
  69.     ImportDlg.Table1.TableName:= DBaseTableName;
  70.     ImportDlg.FieldGetProc:= FieldGet;
  71.     ImportDlg.ShowModal;
  72.   Finally
  73.     ImportDlg.Free;
  74.   end;
  75. end;
  76.  
  77. procedure TImportDlg.FormDestroy(Sender: TObject);
  78. begin
  79.   FreeMem(Data,IsamTable1.RecSize);
  80.   FreeMem(Dup,IsamTable1.RecSize);
  81.   if Table1.Active then Table1.Close;
  82. end;
  83.  
  84. procedure TImportDlg.FormCreate(Sender: TObject);
  85. begin
  86.   Table1.DatabaseName:= 'TEST2';
  87.   FieldGetProc:= NIL;
  88.   if Sprache = 1 then begin
  89.     GroupBox1.Caption:= 'Options';
  90.     AktualRadio.Caption:= 'update only';
  91.     AppendRadio.Caption:= 'append new only';
  92.     AppendAndUpdateRadio.Caption:= 'append and update';
  93.     CancelBtn.Caption:= 'End';
  94.   end;
  95. end;
  96.  
  97. procedure TImportDlg.FormShow(Sender: TObject);
  98. begin
  99.   GetMem(Data,IsamTable1.RecSize);
  100.   GetMem(Dup,IsamTable1.RecSize);
  101.   Table1.Open;
  102. end;
  103.  
  104. procedure TImportDlg.StartBttnClick(Sender: TObject);
  105. var i,RCount: Longint;
  106.     Altprogress,NeuProgress: Integer;
  107.     Key1: IsamKeyStr;
  108. begin
  109.   if Table1.Active then begin
  110.     if IsamTable1.Active then begin
  111.       RCount:= Table1.RecordCount;
  112.       Table1.First;
  113.       i:= 0;
  114.       AltProgress:= 0;
  115.       Repeat
  116.         if IsamOk then begin
  117.           FieldGetProc(DATA^,Table1,IsamTable1);
  118.           Key1:= IsamTable1.Key_Proc(Data^,IsamTable1.KeyNo);
  119.           if IsamTable1.FindKey(Data^,Data^,Key1) then begin
  120.             if (AppendAndUpdateRadio.Checked) or (AktualRadio.Checked) then
  121.             IsamTable1.UpdateRecord(DATA^,DATA^);
  122.           end
  123.           else begin
  124.             if (AppendAndUpdateRadio.Checked) or (AppendRadio.Checked) then
  125.             IsamTable1.Append(DATA^,DATA^);
  126.           end;
  127.           Table1.Next;
  128.         end;
  129.         Inc(i);
  130.         NeuProgress:= Round((i/RCount)*100);
  131.         if AltProgress <> NeuProgress then begin
  132.           AltProgress:= NeuProgress;
  133.           Gauge1.Progress:= NeuProgress;
  134.         end;
  135.       Until (Table1.Eof) or (i = rCount);
  136.     end
  137.     else begin
  138.       if Sprache = 1 then Errorwindow('Isamtable is not opened','')
  139.       else Errorwindow('Isamtabelle ist nicht ge÷ffnet','');
  140.     end;
  141.   end
  142.   else begin
  143.     if Sprache = 1 then Errorwindow('Isamtable is not opened','')
  144.     else Errorwindow('DBASE-Tabelle ist nicht ge÷ffnet','');
  145.   end;
  146. end;
  147.  
  148. end.
  149.